home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / screen.swg / 0065_Text Fader.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  1.5 KB  |  92 lines
  1. Unit dac;
  2.  
  3. Interface
  4.  
  5. Procedure TextFadeIn(Speed : Integer);
  6. Procedure TextFadeOut(Speed : Integer);
  7.  
  8. Implementation
  9. Uses
  10.   Dos, Crt;
  11.  
  12. Type
  13.   DacType = Array[1..256,1..3] of Byte;
  14.  
  15. Var
  16.   dac1,
  17.   dac2   : DacType;
  18.   x, y,
  19.   i, erg,
  20.   gesamt : Word;
  21.  
  22.  
  23. Procedure Read_DACs(Var Dac : DacType);
  24. Var
  25.   r : Registers;
  26. begin
  27.   r.ax := $1017;
  28.   r.bx := 0;
  29.   r.cx := 256;
  30.   r.es := SEG(Dac);
  31.   r.dx := Ofs(Dac);
  32.   Intr($10, r);
  33. end;
  34.  
  35. Procedure Write_DACs(Dac : DacType);
  36. Var
  37.   r : Registers;
  38. begin
  39.  r.ax := $1012;
  40.  r.bx := 0;
  41.  r.cx := 256;
  42.  r.es := seg(Dac);
  43.  r.dx := Ofs(Dac);
  44.  Intr($10, r);
  45. end;
  46.  
  47. { fade....}
  48. Procedure TextFadeOut(Speed : Integer);
  49. begin;
  50.   Repeat
  51.     erg := 0;
  52.     For x := 1 to 256 do
  53.       For y := 1 to 3 do
  54.       begin
  55.         if dac2[x, y] > 0 then
  56.           DEC(dac2[x, y]);
  57.         erg := erg + dac2[x, y];
  58.       end;
  59.     Write_Dacs(dac2);
  60.     Delay(Speed);
  61.   Until erg = 0;
  62. end;
  63.  
  64. { restore....fades also}
  65. Procedure TextFadeIn(Speed : Integer);
  66. begin;
  67.   Repeat
  68.     erg := 0;
  69.     For x := 1 to 256 do
  70.       For y := 1 to 3 do
  71.       begin
  72.        if dac2[x, y] < dac1[x, y] then
  73.          INC(dac2[x,y]);
  74.        erg := erg + dac2[x, y];
  75.       end;
  76.     Write_Dacs(dac2);
  77.     Delay(Speed);
  78.   Until (erg = gesamt) or (KeyPressed);
  79.   Write_Dacs(dac1);
  80. end;
  81.  
  82. begin
  83.   Read_Dacs(dac1);
  84.   dac2 := dac1;
  85.   gesamt := 0;
  86.   For x := 1 to 256 do
  87.     For y := 1 to 3 do
  88.       gesamt := gesamt + dac1[x, y];
  89.  
  90. end.
  91.  
  92.